home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / DUPLPROC.ICN < prev    next >
Text File  |  1993-01-27  |  9KB  |  322 lines
  1. ############################################################################
  2. #
  3. #    File:     duplproc.icn
  4. #
  5. #    Subject:  Program to find duplicate declarations
  6. #
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     December 30, 1991
  10. #
  11. ###########################################################################
  12. #
  13. #    Version:  1.8
  14. #
  15. ###########################################################################
  16. #
  17. #  Use this if you plan on posting utility procedures suitable for
  18. #  inclusion in someone's Icon library directories.
  19. #
  20. #  duplproc.icn compiles into a program which will search through
  21. #  every directory in your ILIBS environment variable (and/or in the
  22. #  directories supplied as arguments to the program).  If it finds any
  23. #  duplicate procedure or record identifiers, it will report this on
  24. #  the standard output.
  25. #
  26. #  It is important to try to use unique procedure names in programs
  27. #  you write, especially if you intend to link in some of the routines
  28. #  contained in the IPL.  Checking for duplicate procedure names has
  29. #  been somewhat tedious in the past, and many of us (me included)
  30. #  must be counted as guilty for not checking more thoroughly.  Now,
  31. #  however, checking should be a breeze.
  32. #
  33. #  BUGS:  Duplproc thinks that differently written names for the same
  34. #  directory are in fact different directories.  Use absolute path
  35. #  names, and you'll be fine.
  36. #
  37. ############################################################################
  38. #
  39. #  Requires:  UNIX (MS-DOS will work if all files are in MS-DOS format)
  40. #
  41. ############################################################################
  42.  
  43. record procedure_stats(name, file, lineno)
  44.  
  45. procedure main(a)
  46.  
  47.     local proc_table, fname, elem, lib_file, tmp, too_many_table
  48.  
  49.     #     usage:  duplproc [libdirs]
  50.     #
  51.     # Where libdirs is a series of space-separated directories in
  52.     # which relevant library files are to be found.  To the
  53.     # directories listed in libdirs are added any directories found in
  54.     # the ILIBS environment variable.
  55.  
  56.     proc_table := table()
  57.     too_many_table := table()
  58.  
  59.     # Put all command-line option paths, and ILIBS paths, into one sorted
  60.     # list.  Then get the names of all .icn filenames in those paths.
  61.     every fname := !get_icn_filenames(getlibpaths(a)) do {
  62.     # For each .icn filename, open that file, and find all procedure
  63.     # calls in it.
  64.     if not (lib_file := open(fname, "r")) then
  65.         write(&errout,"Can't open ",fname," for reading.")
  66.     else {
  67.         # Find all procedure calls in lib_file.
  68.         every elem := !get_procedures(lib_file,fname) do {
  69.         /proc_table[elem.name] := set()
  70.         insert(proc_table[elem.name],elem)
  71.         }
  72.         close(lib_file)
  73.     }
  74.     }
  75.  
  76.     every elem := key(proc_table) do {
  77.     if *proc_table[elem] > 1 then {
  78.         write("\"", elem, "\" is defined in ",*proc_table[elem]," places:")
  79.         every tmp := !proc_table[elem] do {
  80.         write("     ",tmp.file, ", line ",tmp.lineno)
  81.         }
  82.     }
  83.     }
  84.  
  85. end
  86.  
  87.  
  88.  
  89. procedure getlibpaths(ipl_paths)
  90.  
  91.     # Unite command-line args and ILIBS environment variable into one
  92.     # path list.
  93.  
  94.     local i, path
  95.  
  96.     # Make sure all paths have a consistent format (one trailing slash).a
  97.     if *\ipl_paths > 0 then {
  98.     every i := 1 to *ipl_paths do {
  99.         ipl_paths[i] := fixup_path(ipl_paths[i])
  100.     }
  101.     ipl_paths := set(ipl_paths)
  102.     }
  103.     else ipl_paths := set()
  104.  
  105.     # If the ILIBS environment variable is set, read it into
  106.     # ipl_paths.  Spaces - NOT COLONS - are used as separators.
  107.     getenv("ILIBS") ? {
  108.     while path := tab(find(" ")) do {
  109.         insert(ipl_paths, fixup_path(path))
  110.         tab(many(' '))
  111.     }
  112.     insert(ipl_paths, fixup_path(tab(0)))
  113.     }
  114.  
  115.     return sort(ipl_paths)
  116.  
  117. end
  118.  
  119.  
  120.  
  121. procedure fixup_path(s)
  122.     # Make sure paths have a consistent format.
  123.     return "/" ~== (trim(s,'/') || "/")
  124. end
  125.  
  126.  
  127.  
  128. procedure get_procedures(intext,fname)
  129.  
  130.     # Extracts the names of all procedures declared in file f.
  131.     # Returns them in a list, each of whose elements have the
  132.     # form record procedure_stats(procedurename, filename, lineno).
  133.  
  134.     local psl, f_pos, line_no, line
  135.     static name_chars
  136.     initial {
  137.     name_chars := &ucase ++ &lcase ++ &digits ++ '_'
  138.     }
  139.  
  140.     # Initialize procedure-name list, line count.
  141.     psl := list()
  142.     line_no := 0
  143.  
  144.     # Find procedure declarations in intext.
  145.     while line := read(intext) & line_no +:= 1 do {
  146.     take_out_comments(line) ? {
  147.         if tab(match("procedure")) then {
  148.         tab(many(' \t')) &
  149.             put(psl, procedure_stats(
  150.                 "main" ~== tab(many(name_chars)), fname, line_no))
  151.         }
  152.     }
  153.     }
  154.  
  155.     return psl   # returns empty list if no procedures found
  156.  
  157. end
  158.  
  159.  
  160.  
  161. procedure take_out_comments(s)
  162.  
  163.     # Commented-out portions of Icon code - strip 'em.  Fails on lines
  164.     # which, either stripped or otherwise, come out as an empty string.
  165.     #
  166.     # BUG:  Does not handle lines which use the _ string-continuation
  167.     # notation.  Typically take_out_comments barfs on the next line.
  168.  
  169.     local i, j, c, c2, s2
  170.  
  171.     s ? {
  172.     tab(many(' \t'))
  173.     pos(0) & fail
  174.         find("#") | (return trim(tab(0),' \t'))
  175.     match("#") & fail
  176.     (s2 <- tab(find("#"))) ? {
  177.         c2 := &null
  178.         while tab(upto('\\"\'')) do {
  179.         case c := move(1) of {
  180.             "\\"   : {
  181.             if match("^")
  182.             then move(2)
  183.             else move(1)
  184.             }
  185.             default: {
  186.             if \c2
  187.             then (c == c2, c2 := &null)
  188.             else c2 := c
  189.             }
  190.         }
  191.         }
  192.         /c2
  193.     }
  194.     return "" ~== trim((\s2 | tab(0)) \ 1, ' \t')
  195.     }
  196.  
  197. end
  198.  
  199.  
  200.  
  201. procedure get_icn_filenames(lib_paths)
  202.  
  203.     # Return the names of all .icn files in all of the paths in the
  204.     # list lib_paths.  The dir routine used depends on which OS we
  205.     # are running under.
  206.  
  207.     local procedure_stat_list
  208.     static get_dir
  209.     initial get_dir := set_getdir_by_os()
  210.  
  211.     procedure_stat_list := list()
  212.     # Run through every possible path in which files might be found,
  213.     # and get a list of procedures contained in those files.
  214.     every procedure_stat_list |||:= get_dir(!lib_paths)
  215.  
  216.     return procedure_stat_list
  217.  
  218. end
  219.  
  220.  
  221.  
  222. procedure set_getdir_by_os()
  223.  
  224.     if find("UNIX", &features)
  225.     then return unix_get_dir
  226.     else if find("MS-DOS", &features)
  227.     then return msdos_get_dir
  228.     else stop("Your operating system is not (yet) supported.")
  229.  
  230. end
  231.  
  232.  
  233.  
  234. procedure msdos_get_dir(dir)
  235.     local temp_name, filename
  236.  
  237.     # Returns a sorted list of all filenames (full paths included) in
  238.     # directory "dir."  The list is sorted.  Fails on invalid or empty
  239.     # directory.  Aborts if temp file cannot be opened.
  240.     #
  241.     # Temp files can be directed to one or another directory either by
  242.     # manually setting the variable temp_dir below, or by setting the
  243.     # value of the environment variable TEMPDIR to an appropriate
  244.     # directory name.
  245.  
  246.     local in_dir, filename_list, line
  247.     static temp_dir
  248.     initial {
  249.         temp_dir := 
  250.             (trim(map(getenv("TEMPDIR"), "/", "\\"), '\\') || "\\") |
  251.                 ".\\"
  252.     }
  253.  
  254.     # Get name of tempfile to be used.
  255.     temp_name := get_dos_tempname(temp_dir) |
  256.     stop("No more available tempfile names!")
  257.  
  258.     # Make sure we have an unambiguous directory name, with backslashes
  259.     # instead of UNIX-like forward slashes.
  260.     dir := trim(map(dir, "/", "\\"), '\\') || "\\"
  261.  
  262.     # Put dir listing into a temp file.
  263.     system("dir "||dir||" > "||temp_name)
  264.  
  265.     # Put tempfile entries into a list, removing blank- and
  266.     # space-initial lines.  Exclude directories (i.e. return file
  267.     # names only).
  268.     in_dir := open(temp_name,"r") |
  269.     stop("Can't open temp file in directory ",temp_dir,".")
  270.     filename_list := list()
  271.     every filename := ("" ~== !in_dir) do {
  272.         match(" ",filename) | find(" <DIR>", filename) & next
  273.     filename ?:= trim(trim(tab(10)) || "." || tab(13), '. ')
  274.     if filename ? (tab(find(".ICN")+4), pos(0))
  275.     then put(filename_list, map(dir || filename))
  276.     }
  277.  
  278.     # Clean up.
  279.     close(in_dir) & remove(temp_name)
  280.  
  281.     # Check to be sure we actually managed to read some files.
  282.     if *filename_list = 0 then fail
  283.     else return sort(filename_list)
  284.  
  285. end
  286.  
  287.  
  288.  
  289. procedure get_dos_tempname(dir)
  290.    local temp_name, temp_file
  291.  
  292.     # Don't clobber existing files.  Get a unique temp file name for
  293.     # use as a temporary storage site.
  294.  
  295.     every temp_name := dir || "icondir." || right(string(1 to 999),3,"0") do {
  296.     temp_file := open(temp_name,"r") | break
  297.         close(temp_file)
  298.     }
  299.     return \temp_name
  300.  
  301. end
  302.  
  303.  
  304.  
  305. procedure unix_get_dir(dir)
  306.    local filename_list, in_dir, filename
  307.  
  308.     dir := trim(dir, '/') || "/"
  309.     filename_list := list()
  310.     in_dir := open("/bin/ls -F "||dir, "pr")
  311.     every filename := ("" ~== !in_dir) do {
  312.     match("/",filename,*filename) & next
  313.     if filename ? (not match("s."), tab(find(".icn")+4), pos(0))
  314.     then put(filename_list, trim(dir || filename, '*'))
  315.     }
  316.     close(in_dir)
  317.  
  318.     if *filename_list = 0 then fail
  319.     else return filename_list
  320.  
  321. end
  322.